home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / surfmodl / surfm203.arc / SURFSRC.ARC / INREAL.INC < prev    next >
Text File  |  1987-01-13  |  4KB  |  115 lines
  1. function INREAL (var Filin: text; var Realvar: vartype; var Comment: text80;
  2.   Line_num: integer; Interactive: boolean): integer;
  3.  
  4. { Read in a line from or standard Input, and decode the
  5.   numeric input in a reasonable way (similar to Fortran). Allow a trailing
  6.   decimal point, commas between entries, and any number of spaces or tabs.
  7.   If an asterisk is encountered on the line, everything after it is taken
  8.   to be a comment. If the line begins with an asterisk, then the entire
  9.   line is taken to be a comment and another line is read immediately
  10.   WITHOUT EVER RETURNING THE FIRST COMMENT TO THE CALLING PROGRAM.
  11.   To read from standard Input, instead of from a file,
  12.   set the Interactive flag to TRUE (otherwise FALSE).  If not Interactive,
  13.   then INREAL never returns 0 variables; it always reads another line.
  14.   If Interactive, then 0 variables is a legal return.
  15. }
  16. var Line: string[127];            { line of input }
  17.     i: integer;                   { points to character in Line }
  18.     j: integer;                   { general index }
  19.     Num: integer;                 { number of numeric entry }
  20.     Firstdig: integer;            { pointer to first digit of entry }
  21.     Lennum: integer;              { length of total numeric entry }
  22.     Ndeci: integer;               { # decimal pts. in entry }
  23.     Retcode: integer;             { return code from function }
  24.     Lastcomma: boolean;           { keep track of whether last significant
  25.                                     character was a comma }
  26.  
  27. begin
  28.   Lastcomma := TRUE;
  29.   Comment := '';
  30.   Num := 0;
  31.   Line := '*';
  32.   while (Line[1] = '*') do begin
  33.     if (Interactive) then begin
  34.       readln (Line);
  35.       if (length(Line) = 0) then
  36.         Line[1] := ' ';
  37.     end
  38.     else
  39.       readln (Filin, Line);
  40.   end;
  41.   Line[length(Line)+1] := ' ';
  42.   i := 1;
  43.   while (i <= length(Line)) and (Num < MAXVAR) and (Num >= 0) do begin
  44.     if (Line[i] = ' ') or (Line[i] = ^I) or (Line[i] = ',') or
  45.        (Line[i] = ^M) then begin
  46.       if (Lastcomma) and (Line[i] = ',') then begin
  47.         { Two commas in a row: a 0 input }
  48.         Num := Num + 1;
  49.         Realvar[Num] := 0;
  50.       end
  51.       else if (Line[i] = ',') then
  52.         Lastcomma := TRUE;
  53.       i := i + 1;
  54.     end
  55.     else if ((Line[i] <= '9') and (Line[i] >= '0')) or (Line[i] = '.') or
  56.             (Line[i] = '-') then begin
  57.       Lastcomma := FALSE;
  58.       Num := Num + 1;
  59.       Firstdig := i;
  60.       Lennum := 1;
  61.       i := i + 1;
  62.       while (i <= length(Line)) and (((Line[i] <= '9') and (Line[i] >= '0'))
  63.             or (Line[i] = '.') or (Line[i] = 'E') or (Line[i] = 'e')
  64.             or (Line[i] = '-') or (Line[i] = '+')) do begin
  65.         Lennum := Lennum + 1;
  66.         i := i + 1;
  67.       end;
  68.       if Line[i] = '.' then
  69.         { Remove trailing decimal point }
  70.         Lennum := Lennum - 1;
  71.       if (Lennum < 1) then
  72.         { Flag bad entry }
  73.         Num := -i
  74.       else begin
  75.  
  76.         { silly code to convert to 4.0 so -.1 and 1. work }
  77.         if (lennum > 0) and (line[firstdig + lennum - 1] = '.') then
  78.           lennum := lennum - 1;
  79.         if line[Firstdig] = '.' then
  80.           val ('0'+copy (Line, Firstdig, Lennum), Realvar[Num], Retcode)
  81.         else if (line[firstdig] = '-') and (line[firstdig + 1] = '.') then
  82.           val ('-0' + copy (Line, Firstdig + 1, Lennum - 1),
  83.               Realvar[Num], Retcode)
  84.         else
  85.           val (copy (Line, Firstdig, Lennum), Realvar[Num], Retcode);
  86.         if (Retcode > 0) then begin
  87.           Num := -(Firstdig + Retcode - 1);
  88.         end;
  89.       end;
  90.     end else if (Line[i] = '*') then begin
  91.       Comment := copy(Line, i+1, length(Line)-i);
  92.       i := length(Line) + 1;    { just to stop the while loop }
  93.     end else
  94.       Num := -i;  { flag bad character }
  95.   end; {while}
  96.  
  97.   if (Num < 0) then begin
  98.     if (Line_num > 0) then
  99.       writeln ('Bad input found in line ', Line_num,':')
  100.     else
  101.       writeln ('Bad input:');
  102.     writeln (Line);
  103.     for j := 1 to (-Num-1) do
  104.       write ('-');
  105.     write ('^');
  106.     for j := (-Num+1) to length(Line) do
  107.       write ('-');
  108.     writeln;
  109.     writeln ('Numeric input was expected.');
  110.     writeln ('(The carat (^) points to the bad character.)');
  111.   end; { if Num }
  112.  
  113.   Inreal := Num;
  114. end; { function Inreal }
  115.